home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Comms Spectacular / Hotlist2HTML folder / Hotlist2HTML.f next >
Encoding:
Text File  |  1994-01-14  |  3.6 KB  |  142 lines  |  [TEXT/MPS ]
  1. !!MP    inlines.f
  2.     program hotlis
  3. c
  4. c   Hotlist2HTML
  5. c
  6. c   Read the NCSA Mosaic (V. 1.0.2) Hotlist and generates a HTML page
  7. c   from it. Output is written to a user selectable file.
  8. c
  9. c   Compilation of this program requires the Language Systems Fortran 3.0
  10. c   compiler or a later Version, running under MPW 3.2.3.
  11. c   Furthermore, System 7 Toolbox routines are called. 
  12. c
  13. c   Lutz Weimann   Version 0.6     14.1.94
  14. c
  15.     implicit none
  16. c
  17. !!I        Standardfile.f
  18. c
  19.     logical export
  20.     parameter (export=.true.)
  21.     integer outunit
  22.     parameter (outunit=20)
  23. c
  24. c
  25.     external WriteHTMLHotlist
  26.     integer*2 refnum, vRefNum, err
  27.     pointer /ptr/ menuh, urlsh
  28.     record /SFTypeList/ MyTypes
  29.     record /StandardFileReply/ ReplyRecord
  30.     string*255 HotlistName, thestring
  31. c
  32.     if (export) call InitialAboutBox()
  33. c
  34.     MyTypes.OSTy(0)='HOTL'
  35.     Call StandardGetFile(nil,Int2(1),MyTypes,ReplyRecord)
  36.     if (.not.ReplyRecord.sfGood) stop 'Hotlist selection canceled!'
  37.     HotlistName = ReplyRecord.sfFile.name
  38.     call F_SetDefaultFileName (HotlistName//'.html')
  39.     open (20,file=*'Save HTML page as:',status='new')
  40. c
  41.     refnum = FSpOpenResfile(ReplyRecord.sfFile,Int1(1))
  42.     if (ResError().ne.0) stop 'OpenResfile: Cannot open Hotlist!'
  43. c
  44.     call UseResFile(refnum)
  45.     if (ResError().ne.0) stop 'UseResFile failed!'
  46. c
  47.     thestring = 'Menu'
  48.     menuh = GetNamedResource('STR#',thestring)
  49.     if (ResError().ne.0) stop 'Cant find STR# Resource Menu!'
  50. c
  51.     thestring = 'URLs'
  52.     urlsh = GetNamedResource('STR#',thestring)
  53.     if (ResError().ne.0) stop 'Cant find STR# Resource URLs!'
  54. c
  55.     call WriteHTMLHotlist(outunit, HotlistName, 
  56.      $                    %val(menuh^.p), %val(urlsh^.p))
  57. c
  58.     close(outunit)
  59.      call CloseResFile(refnum)
  60.     if (ResError().ne.0) stop 'CloseResFile failed!'
  61.     end
  62. c
  63. c
  64.     subroutine WriteHTMLHotlist(outunit, HotlistFileName, Menu, URLs)
  65.     implicit none
  66.     integer outunit
  67.     string*255 HotlistFileName
  68.     integer*1 Menu(*), URLs(*)
  69. c
  70.     integer numMenu, numURLs, ptrMenu, ptrURLs, lMenu, lURLs,
  71.      $      i, j, loopbound
  72.     character*255 CharMenuBuf, CharURLsBuf
  73.     integer*1 IntMenuBuf(255), IntURLsBuf(255)
  74.     equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
  75.     string*255 Message
  76.     character*9 datestring
  77. c
  78.     numMenu = Menu(1)*256+Menu(2)
  79.     numURLs = URLs(1)*256+URLs(2)
  80.     if (numMenu.ne.numURLs) then
  81.         Message = 'Different number of menuitems and URLs found.'//
  82.      $            'I generate a list of the lower number length'
  83.         call AlertBox(Message)
  84.     endif
  85.     write(20,1001) HotlistFileName
  86.     loopbound = min(numMenu, numURLs)
  87.     ptrMenu = 3
  88.     ptrURLs = 3
  89.     do i=1,loopbound
  90.         lMenu = Menu(ptrMenu)
  91.         do j=1,lMenu
  92.             IntMenuBuf(j) = Menu(ptrMenu+j)
  93.         enddo
  94.         ptrMenu = ptrMenu+lMenu+1
  95.         lURLs = URLs(ptrURLs)
  96.         do j=1,lURLs
  97.             IntURLsBuf(j) = URLs(ptrURLs+j)
  98.         enddo
  99.         ptrURLs = ptrURLs+lURLs+1
  100.         write(outunit,1002) CharURLsBuf(1:lURLs),CharMenuBuf(1:lMenu)
  101.     enddo
  102.     call date(datestring)
  103.     write(outunit,1003) HotlistFileName,datestring
  104.     return
  105. c
  106. 1001  format('<TITLE>',a,'</TITLE>',/,'<UL>')
  107. 1002  format('<LI> <A HREF= "',a,'">',a,'</A>')
  108. 1003  format('</UL>',/,'<ADDRESS>Generated from ',a,' at ',a,'</ADDRESS>',/)
  109.     end
  110. c
  111. c
  112.     Subroutine InitialAboutBox()
  113.     implicit none
  114. c
  115. !!I    Dialogs.f
  116. !!I    Events.f
  117. c
  118.     integer*2 AboutDialogID
  119.     parameter (AboutDialogID=32002)
  120. c
  121.     record /EventRecord/ theEvent
  122.     record /DialogRecord/ AboutDialog
  123.     record /DialogPtr/ AboutDialogPtr
  124.     integer*2 itemhit
  125.     logical status
  126. c
  127.     call InitDialogs(nil)
  128.     AboutDialogPtr = GetNewDialog(AboutDialogID, %ref(AboutDialog), -1)
  129. c
  130.     do while (.not.GetNextEvent(mDownMask,theEvent))
  131.         if (GetNextEvent(updateMask,theEvent)) then
  132.             if (.not.IsDialogEvent(theEvent)) cycle
  133.             status = DialogSelect(theEvent,%ref(AboutDialogPtr),%ref(itemhit))
  134.         endif
  135.     enddo
  136.     call DisposDialog(AboutDialogPtr)
  137.     return
  138.     end
  139.     
  140.     
  141.     
  142.